home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].zip / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].adf / Modula-2 / m2 / AMIGADos.MOD < prev    next >
Text File  |  1988-03-15  |  9KB  |  357 lines
  1. (********************************************************************************
  2.  
  3. Name         : AMIGADos.MOD
  4. Version      : 1.0
  5. Purpose      : Interface to AMIGADos
  6. Authors      : cn/jr/ms/red
  7. Modified     : 12.3.86  20:25  cn
  8. State        : should be ok
  9. Requirements : 
  10.  
  11. ********************************************************************************)
  12.  
  13. IMPLEMENTATION MODULE AMIGADos;
  14.  
  15. FROM SYSTEM     IMPORT ADDRESS, ADR;
  16. FROM AMIGABase  IMPORT Regs, ExecBase, ExecOpenLib, LibCall;
  17.  
  18. CONST 
  19.   (* File Handling  *)
  20.      close              =  -36;
  21.      createDir          = -120;
  22.      currentDir         = -126;
  23.      deleteFile         =  -72;
  24.      dupLock            =  -96;
  25.      examine            = -102;
  26.      exNext             = -108;
  27.      info               = -114;
  28.      input              =  -54;
  29.      ioErr              = -132;
  30.      isInteractive      = -216;
  31.      lock               =  -84;
  32.      open               =  -30;
  33.      output             =  -60;
  34.      parentDir          = -210;
  35.      read               =  -42;
  36.      rename             =  -78;
  37.      seek               =  -66;
  38.      setComment         = -180;
  39.      setProtection      = -186;
  40.      unLock             =  -90;
  41.      waitForChar        = -204;
  42.      write              =  -48;
  43.  
  44.   (* Process Handling *)
  45.      createProc         = -138;
  46.      dateStamp          = -192;
  47.      delay              = -198;
  48.      deviceProc         = -174;
  49.      exit               = -144;
  50.  
  51.   (* Loading Code *)
  52.      execute            = -222;
  53.      loadSeg            = -150;
  54.      unLoadSeg          = -156;
  55.  
  56. TYPE String0C           = ARRAY [0..127] OF CHAR;
  57.      AMIGALockPtr       = ADDRESS;
  58.      AMIGAFile          = ADDRESS;
  59.  
  60. VAR  DosLib: ADDRESS;
  61.      reg: Regs;
  62.      AMIGAString: String0C;
  63.       
  64. PROCEDURE MakeAMIGAString(s: ARRAY OF CHAR);
  65.   VAR i: CARDINAL;
  66. BEGIN
  67.   i:=0;
  68.   WHILE (i<=HIGH(s)) AND (s[i]#0C) DO
  69.     AMIGAString[i]:=s[i];
  70.     INC(i)
  71.   END;
  72.   AMIGAString[i]:=0C
  73. END MakeAMIGAString;
  74.  
  75. PROCEDURE Close(f: AMIGAFile);
  76. BEGIN
  77.   reg.d[1]:=LONGINT(f);
  78.   LibCall(DosLib, close, reg);
  79. END Close;
  80.  
  81. PROCEDURE CreateDir(name: ARRAY OF CHAR): AMIGALockPtr;
  82. BEGIN
  83.   MakeAMIGAString(name);
  84.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  85.   LibCall(DosLib, createDir, reg);
  86.   RETURN AMIGALockPtr(reg.d[0])
  87. END CreateDir;
  88.  
  89. PROCEDURE CurrentDir(lockPtr: AMIGALockPtr): AMIGALockPtr;
  90. BEGIN
  91.   reg.d[1]:=LONGINT(lockPtr);
  92.   LibCall(DosLib, currentDir, reg);
  93.   RETURN AMIGALockPtr(reg.d[0])
  94. END CurrentDir;
  95.  
  96. PROCEDURE DeleteFile(name: ARRAY OF CHAR; VAR done: BOOLEAN);
  97. BEGIN
  98.   MakeAMIGAString(name);
  99.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  100.   LibCall(DosLib, deleteFile, reg);
  101.   done:=reg.d[0]#0D
  102. END DeleteFile;
  103.  
  104. PROCEDURE DupLock(lockPtr: AMIGALockPtr): AMIGALockPtr;
  105. BEGIN
  106.   reg.d[1]:=LONGINT(lockPtr);
  107.   LibCall(DosLib, dupLock, reg);
  108.   RETURN AMIGALockPtr(reg.d[0])
  109. END DupLock;
  110.  
  111. PROCEDURE Examine(lockPtr: AMIGALockPtr;
  112.                   VAR fileInfo: AMIGAFileInfoBlock; VAR done: BOOLEAN);
  113. BEGIN
  114.   reg.d[1]:=LONGINT(lockPtr);
  115.   reg.d[2]:=LONGINT(ADR(fileInfo));
  116.   LibCall(DosLib, examine, reg);
  117.   done:=reg.d[0]#0D
  118. END Examine;
  119.  
  120. PROCEDURE ExNext(lockPtr: AMIGALockPtr;
  121.                   VAR fileInfo: AMIGAFileInfoBlock; VAR done: BOOLEAN);
  122. BEGIN
  123.   reg.d[1]:=LONGINT(lockPtr);
  124.   reg.d[2]:=LONGINT(ADR(fileInfo));
  125.   LibCall(DosLib, exNext, reg);
  126.   done:=reg.d[0]#0D
  127. END ExNext;
  128.  
  129. PROCEDURE Info(lockPtr: AMIGALockPtr;
  130.                VAR infoData: AMIGAInfoData; VAR done: BOOLEAN);
  131. BEGIN
  132.   reg.d[1]:=LONGINT(lockPtr);
  133.   reg.d[2]:=LONGINT(ADR(infoData));
  134.   LibCall(DosLib, info, reg);
  135.   done:=reg.d[0]#0D
  136. END Info;
  137.   
  138. PROCEDURE Input(): AMIGAFile;
  139. BEGIN
  140.   LibCall(DosLib, input, reg);
  141.   RETURN AMIGAFile(reg.d[0])
  142. END Input;
  143.  
  144. PROCEDURE IoErr(): LONGINT;
  145. BEGIN
  146.   LibCall(DosLib, ioErr, reg);
  147.   RETURN reg.d[0];
  148. END IoErr;
  149.  
  150. PROCEDURE IsInteractive(f: AMIGAFile): BOOLEAN;
  151. BEGIN
  152.   reg.d[1]:=LONGINT(f);
  153.   LibCall(DosLib, isInteractive, reg);
  154.   RETURN reg.d[0]#0D
  155. END IsInteractive;
  156.  
  157. PROCEDURE Lock(name: ARRAY OF CHAR;
  158.                accessWrite: BOOLEAN): AMIGALockPtr;
  159. BEGIN
  160.   MakeAMIGAString(name);
  161.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  162.   IF accessWrite THEN
  163.     reg.d[2]:=-2
  164.   ELSE
  165.     reg.d[2]:=-1
  166.   END;
  167.   LibCall(DosLib, lock, reg);
  168.   RETURN AMIGALockPtr(reg.d[0])
  169. END Lock;
  170.  
  171. PROCEDURE Open(name: ARRAY OF CHAR; newFile: BOOLEAN): AMIGAFile;
  172. BEGIN
  173.   MakeAMIGAString(name);
  174.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  175.   IF newFile THEN
  176.     reg.d[2]:=1006
  177.   ELSE
  178.     reg.d[2]:=1005
  179.   END;
  180.   LibCall(DosLib, open, reg);
  181.   RETURN AMIGAFile(reg.d[0])
  182. END Open;
  183.  
  184. PROCEDURE Output(): AMIGAFile;
  185. BEGIN
  186.   LibCall(DosLib, output, reg);
  187.   RETURN AMIGAFile(reg.d[0])
  188. END Output;
  189.  
  190. PROCEDURE ParentDir(lockPtr: AMIGALockPtr): AMIGALockPtr;
  191. BEGIN
  192.   reg.d[1]:=LONGINT(lockPtr);
  193.   LibCall(DosLib, parentDir, reg);
  194.   RETURN AMIGALockPtr(reg.d[0])
  195. END ParentDir;
  196.  
  197. PROCEDURE Read(f: AMIGAFile; buffer: ADDRESS; length: LONGINT): LONGINT;
  198. BEGIN
  199.   reg.d[1]:=LONGINT(f);
  200.   reg.d[2]:=LONGINT(buffer);
  201.   reg.d[3]:=length;
  202.   LibCall(DosLib, read, reg);
  203.   RETURN reg.d[0]
  204. END Read;
  205.   
  206. PROCEDURE Rename(oldname, newname: ARRAY OF CHAR; VAR done: BOOLEAN);
  207. VAR new:String0C;
  208. BEGIN
  209.   MakeAMIGAString(newname);
  210.   new:=AMIGAString;
  211.   MakeAMIGAString(oldname);
  212.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  213.   reg.d[2]:=LONGINT(ADR(new));
  214.   LibCall(DosLib, rename, reg);
  215.   done:=reg.d[0]#0D
  216. END Rename;
  217.  
  218. PROCEDURE Seek(f: AMIGAFile; pos: LONGINT; seekMode: AMIGASeekMode): LONGINT;
  219. BEGIN
  220.   reg.d[1]:=LONGINT(f);
  221.   reg.d[2]:=pos;
  222.   CASE seekMode OF
  223.   | ofsBeginning: reg.d[3]:=-1D;
  224.   | ofsCurrent:   reg.d[3]:= 0D;
  225.   | ofsEnd:       reg.d[3]:= 1D;
  226.   END;
  227.   LibCall(DosLib, seek, reg);
  228.   RETURN reg.d[0];
  229. END Seek;
  230.  
  231. PROCEDURE SetComment(name, comment: ARRAY OF CHAR; VAR done: BOOLEAN);
  232. VAR comm:String0C;
  233. BEGIN
  234.   MakeAMIGAString(comment);
  235.   comm:=AMIGAString;
  236.   MakeAMIGAString(name);
  237.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  238.   reg.d[2]:=LONGINT(ADR(comm));
  239.   LibCall(DosLib, setComment, reg);
  240.   done:=reg.d[0]#0D
  241. END SetComment;
  242.  
  243. PROCEDURE SetProtection(name: ARRAY OF CHAR;
  244.                         mask: AMIGAFileProtectSET; VAR done: BOOLEAN);
  245. BEGIN
  246.   MakeAMIGAString(name);
  247.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  248.   reg.d[2]:=LONGINT(mask);
  249.   LibCall(DosLib, setProtection, reg);
  250.   done:=reg.d[0]#0D
  251. END SetProtection;
  252.  
  253. PROCEDURE UnLock(lockPtr: AMIGALockPtr);
  254. BEGIN
  255.   reg.d[1]:=LONGINT(lockPtr);
  256.   LibCall(DosLib, unLock, reg);
  257. END UnLock;
  258.  
  259. PROCEDURE WaitForChar(f: AMIGAFile; timeout: LONGINT): BOOLEAN;
  260. BEGIN
  261.   reg.d[1]:=LONGINT(f);
  262.   reg.d[2]:=timeout;
  263.   LibCall(DosLib, waitForChar, reg);
  264.   RETURN reg.d[0]#0D
  265. END WaitForChar;
  266.  
  267. PROCEDURE Write(f: AMIGAFile; buffer: ADDRESS; length: LONGINT): LONGINT;
  268. BEGIN
  269.   reg.d[1]:=LONGINT(f);
  270.   reg.d[2]:=LONGINT(buffer);
  271.   reg.d[3]:=length;
  272.   LibCall(DosLib, write, reg);
  273.   RETURN reg.d[0]
  274. END Write;
  275.  
  276.  
  277. TYPE AMIGAProcessPtr = ADDRESS;
  278.      AMIGASegmentPtr = ADDRESS;
  279.  
  280.  
  281. PROCEDURE CreateProc(name: ARRAY OF CHAR; priorty: LONGINT;
  282.                      segment: AMIGASegmentPtr;
  283.                      stackSize: LONGINT): AMIGAProcessPtr;
  284. BEGIN
  285.   MakeAMIGAString(name);
  286.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  287.   reg.d[2]:=priorty;
  288.   reg.d[3]:=LONGINT(segment);
  289.   reg.d[4]:=stackSize;
  290.   LibCall(DosLib, createProc, reg);
  291.   RETURN AMIGAProcessPtr(reg.d[0])
  292. END CreateProc;
  293.  
  294. PROCEDURE DateStamp(VAR v: AMIGADateStamp);
  295. BEGIN
  296.   reg.d[1]:=LONGINT(ADR(v));
  297.   LibCall(DosLib, dateStamp, reg);
  298. END DateStamp;
  299.  
  300. PROCEDURE Delay(timeout: LONGINT);
  301. BEGIN
  302.   reg.d[1]:=timeout;
  303.   LibCall(DosLib, delay, reg);
  304. END Delay;
  305.  
  306. PROCEDURE DeviceProc(name: ARRAY OF CHAR): AMIGAProcessPtr;
  307. BEGIN
  308.   MakeAMIGAString(name);
  309.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  310.   LibCall(DosLib, deviceProc, reg);
  311.   RETURN AMIGAProcessPtr(reg.d[0])
  312. END DeviceProc;
  313.  
  314. PROCEDURE Exit(returnCode: LONGINT);
  315. BEGIN
  316.   reg.d[1]:=returnCode;
  317.   LibCall(DosLib, exit, reg)
  318. END Exit;
  319.  
  320. PROCEDURE Execute(command: ARRAY OF CHAR;
  321.                   VAR input, output: AMIGAFile; VAR done: BOOLEAN);
  322. BEGIN
  323.   MakeAMIGAString(command);
  324.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  325.   reg.d[2]:=LONGINT(input);
  326.   reg.d[3]:=LONGINT(output);
  327.   LibCall(DosLib, execute, reg);
  328.   done:=reg.d[0]#0D
  329. END Execute;
  330.  
  331. PROCEDURE LoadSeg(name: ARRAY OF CHAR): AMIGASegmentPtr;
  332. BEGIN
  333.   MakeAMIGAString(name);
  334.   reg.d[1]:=LONGINT(ADR(AMIGAString));
  335.   LibCall(DosLib, loadSeg, reg);
  336.   RETURN AMIGASegmentPtr(reg.d[0])
  337. END LoadSeg;
  338.  
  339. PROCEDURE UnLoadSeg(segment: AMIGASegmentPtr);
  340. BEGIN
  341.   reg.d[1]:=LONGINT(segment);
  342.   LibCall(DosLib, unLoadSeg, reg);
  343. END UnLoadSeg;
  344.  
  345. VAR
  346.   st: ARRAY [0..15] OF CHAR;
  347.   p: POINTER TO ADDRESS;
  348.   r: Regs;
  349.  
  350. BEGIN
  351.   st:='dos.library';
  352.   r.a[1]:=ADR(st);
  353.   r.d[0]:=0;                           (* Version 0 ! *)
  354.   LibCall(ExecBase(), ExecOpenLib(), r);   
  355.   DosLib:=r.d[0];
  356. END AMIGADos.
  357.